home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / hyperbole / hmail.el < prev    next >
Encoding:
Text File  |  1995-04-17  |  10.9 KB  |  291 lines
  1. ;;!emacs
  2. ;;
  3. ;; FILE:         hmail.el
  4. ;; SUMMARY:      Support for Hyperbole buttons embedded in e-mail messages.
  5. ;; USAGE:        GNU Emacs Lisp Library
  6. ;; KEYWORDS:     hypermedia, mail
  7. ;;
  8. ;; AUTHOR:       Bob Weiner
  9. ;; ORG:          Brown U.
  10. ;;
  11. ;; ORIG-DATE:     9-Oct-91 at 18:38:05
  12. ;; LAST-MOD:     14-Apr-95 at 16:03:03 by Bob Weiner
  13. ;;
  14. ;; This file is part of Hyperbole.
  15. ;; Available for use and distribution under the same terms as GNU Emacs.
  16. ;;
  17. ;; Copyright (C) 1991-1995, Free Software Foundation, Inc.
  18. ;; Developed with support from Motorola Inc.
  19. ;;
  20. ;; DESCRIPTION:  
  21. ;;
  22. ;;   The 'hmail' class provides an abstract interface for connecting
  23. ;;   GNU Emacs-based mail readers and composers to Hyperbole.  Its
  24. ;;   public variables together with supporting classes determine the
  25. ;;   mail tools that Hyperbole will support.
  26. ;;
  27. ;;   The 'rmail' and 'lmail' classes provide a set of feature names
  28. ;;   that Hyperbole packages can call to interface to a user's selected
  29. ;;   mail reader.  Eventually, a full abstract calling interface may be
  30. ;;   developed.  The public features (the ones above the line of dashes)
  31. ;;   must be redefined for any mail reader.  The private features are
  32. ;;   used only by a particular mail reader.
  33. ;;
  34. ;;   The 'smail' class is similar; it connects a mail composer for use
  35. ;;   with Hyperbole.
  36. ;;
  37. ;; DESCRIP-END.
  38.  
  39. ;;; ************************************************************************
  40. ;;; Public variables
  41. ;;; ************************************************************************
  42.  
  43. (defvar hnews:composer  'news-reply-mode
  44.  "Major mode for composing USENET news to be sent with Hyperbole buttons.")
  45. (defvar hnews:lister    'gnus-summary-mode
  46.  "Major mode for listing USENET news header summaries with Hyperbole buttons.")
  47. (defvar hnews:reader    'gnus-article-mode
  48.  "Major mode for reading USENET news with Hyperbole buttons.")
  49.  
  50. (defvar hmail:init-function nil
  51.   "*Function (a symbol) to run to initialize Hyperbole support for a mail reader/composer.
  52. Valid values are: nil, Rmail-init, Vm-init, Mh-init, or Pm-init.")
  53.  
  54. (defvar hmail:composer  'mail-mode
  55.  "Major mode for composing mail to be sent with Hyperbole buttons.")
  56. (defvar hmail:lister    nil
  57.  "Major mode for listing mail header summaries with Hyperbole buttons.")
  58. (defvar hmail:modifier  nil
  59.  "Major mode for editing received mail with Hyperbole buttons.")
  60. (defvar hmail:reader    nil
  61.  "Major mode for reading mail with Hyperbole buttons.")
  62.  
  63. ;;; ************************************************************************
  64. ;;; Public functions
  65. ;;; ************************************************************************
  66.  
  67. ;;; ========================================================================
  68. ;;; hmail class - abstract
  69. ;;; ========================================================================
  70.  
  71. (defun hmail:hbdata-start (&optional msg-start msg-end)
  72.   "Returns point immediately before any Hyperbole button data in current msg.
  73. Returns message end point when no button data is found.
  74. Has side-effect of widening buffer. 
  75. Message's displayable part begins at optional MSG-START and ends at or before
  76. MSG-END."
  77.   (widen)
  78.   (or msg-end (setq msg-end (point-max)))
  79.   (save-excursion
  80.     (goto-char msg-end)
  81.     (if (search-backward hmail:hbdata-sep msg-start t) (1- (point)) msg-end)))
  82.  
  83. (defun hmail:hbdata-to-p ()
  84.   "Moves point to Hyperbole but data start in an e-mail msg.
  85. Returns t if button data is found."
  86.   (and (cond ((memq major-mode (list hmail:reader hmail:modifier))
  87.           (rmail:msg-narrow) t)
  88.          ((or (hmail:lister-p) (hnews:lister-p)) t)
  89.          ((memq major-mode (list hmail:composer hnews:reader
  90.                      hnews:composer))
  91.           (widen) t))
  92.        (progn
  93.      (goto-char (point-max))
  94.      (if (search-backward hmail:hbdata-sep nil t)
  95.          (progn (forward-line 1) t)))))
  96.  
  97. (defun hmail:browser-p ()
  98.   "Returns t iff current major mode helps browse received e-mail messages."
  99.   (memq major-mode (list hmail:reader hmail:lister)))
  100.  
  101. (defun hmail:buffer (&optional buf)
  102.   "Start composing mail with optional BUF included in message.
  103. BUF defaults to current buffer.  BUF may be a buffer or buffer name."
  104.   (interactive (list (current-buffer)))
  105.   (or buf (setq buf (current-buffer)))
  106.   (if (stringp buf) (setq buf (get-buffer buf)))
  107.   (hmail:invoke)
  108.   (save-excursion
  109.     (if (search-forward mail-header-separator nil t)
  110.     ;; Within header, so move to body
  111.     (goto-char (point-max)))
  112.     (if buf (insert-buffer buf)))
  113.   (subst-char-in-region (point-min) (point-max) ?\^M ?\n t))
  114.  
  115. ;;;###autoload
  116. (defun hmail:compose (address expr &optional subject help)
  117.   "Compose mail with ADDRESS and evaluation of EXPR.
  118. Optional SUBJECT and HELP message may also be given."
  119.   (interactive "sDeliver e-mail to: \nSubject: ")
  120.   (require 'hactypes) ;; Needed in case EXPR calls 'hact.
  121.   (if (or (stringp help) (stringp subject))
  122.       nil
  123.     (setq subject "Be explicit here.  Make a statement or ask a question."))
  124.   (hmail:invoke address nil subject)
  125.   (eval expr)
  126.   (if (re-search-backward "^Subject: " nil t)
  127.       (goto-char (match-end 0)))
  128.   (message (if (stringp help)
  129.            help
  130.          "Replace subject, compose message, and then mail.")))
  131.  
  132. (defun hmail:composing-dir (key-src)
  133.   "If button KEY-SRC is a mail/news composure buffer, returns composure directory, else nil."
  134.   (save-excursion
  135.     (and (bufferp key-src)
  136.      (progn (set-buffer key-src)
  137.         (or (eq major-mode hmail:composer)
  138.             (eq major-mode hnews:composer)))
  139.      default-directory)))
  140.  
  141. (defun hmail:editor-p ()
  142.   "Returns t iff current major mode edits Hyperbole e-mail/news messages."
  143.   (memq major-mode (list hmail:composer hnews:composer hmail:modifier)))
  144.  
  145. (defun hmail:init (class-prefix func-suffix-list)
  146.   "Sets up CLASS-PREFIX functions with aliases for FUNC-SUFFIX-LIST.
  147. 'hmail:reader' should be set appropriately before this is called."
  148.   (if (null hmail:reader)
  149.       nil
  150.     (let* ((reader-name (symbol-name hmail:reader))
  151.        (reader-prefix (capitalize
  152.                (substring reader-name
  153.                       0 (string-match "-" reader-name))))
  154.        hmail-func)
  155.       (mapcar (function
  156.            (lambda (func-suffix)
  157.          (setq hmail-func (hypb:replace-match-string
  158.                    "Summ-" func-suffix ""))
  159.          (fset (intern (concat class-prefix hmail-func))
  160.                (intern (concat reader-prefix "-" func-suffix)))))
  161.           func-suffix-list))))
  162.  
  163. (defun hmail:invoke (&optional address cc subject)
  164.   "Invoke user preferred mail composer: vm-mail, mh-send or mail.
  165. Optional arguments are ADDRESS, CC list and SUBJECT of mail."
  166.   (or address (setq address ""))
  167.   (or cc (setq cc ""))
  168.   (or subject (setq subject ""))
  169.   (cond ((and (featurep 'vm) (fboundp 'vm-mail))
  170.      (vm-mail)
  171.      (insert address)
  172.      (cond ((re-search-forward "^CC: " nil t)
  173.         (end-of-line)
  174.         (insert cc))
  175.            ((not (equal cc ""))
  176.         (forward-line 1)
  177.         (insert "CC: " cc)))
  178.      (if (re-search-forward "^Subject: " nil t)
  179.          (progn (end-of-line)
  180.             (save-excursion
  181.               (insert subject)))))
  182.     ((and (featurep 'mh-e) (fboundp 'mh-send))
  183.      (mh-send address cc subject))
  184.     (t
  185.      ;; Next 3 lines prevent blank lines between fields due to
  186.      ;; fill-region-as-paragraph within mail-setup.
  187.      (if (equal address "") (setq address nil))
  188.      (if (equal cc "") (setq cc nil))
  189.      (if (equal subject "") (setq subject nil))
  190.      (mail nil address subject nil cc))))
  191.  
  192. (defun hmail:lister-p ()
  193.   "Returns t iff current major mode is a Hyperbole e-mail lister mode."
  194.   (eq major-mode hmail:lister))
  195.  
  196. (defun hnews:lister-p ()
  197.   "Returns t iff current major mode is a Hyperbole news summary lister mode."
  198.   (eq major-mode hnews:lister))
  199.  
  200. (defun hmail:mode-is-p ()
  201.   "Returns current major mode if a Hyperbole e-mail or news mode, else nil."
  202.   (car (memq major-mode
  203.          (list hmail:reader hmail:composer hmail:lister hmail:modifier
  204.            hnews:reader hnews:composer hnews:lister)
  205.          )))
  206.  
  207. (defun hmail:msg-narrow (&optional msg-start msg-end)
  208.   "Narrows buffer to displayable part of current message.
  209. Its displayable part begins at optional MSG-START and ends at or before
  210. MSG-END."
  211.   (if (hmail:reader-p) (rmail:msg-widen))
  212.   (setq msg-start (or msg-start (point-min))
  213.     msg-end (or msg-end (point-max)))
  214.   (narrow-to-region msg-start (hmail:hbdata-start msg-start msg-end)))
  215.  
  216. (defun hmail:reader-p ()
  217.   "Returns t iff current major mode shows received Hyperbole e-mail messages."
  218.   (memq major-mode (list hmail:reader hmail:modifier)))
  219.  
  220. (defun hmail:region (start end &optional buf)
  221.   "Start composing mail with region between START and END included in message.
  222. Optional BUF defaults to current buffer.  BUF may be a buffer or buffer name."
  223.   (interactive (list (region-beginning) (region-end) (current-buffer)))
  224.   (or buf (setq buf (current-buffer)))
  225.   (if (stringp buf) (setq buf (get-buffer buf)))
  226.   (let (mail-buf)
  227.     (hmail:invoke)
  228.     (setq mail-buf (current-buffer))
  229.     (save-excursion
  230.       (if (search-forward mail-header-separator nil t)
  231.       ;; Within header, so move to body
  232.       (goto-char (point-max)))
  233.       (set-buffer buf)
  234.       (append-to-buffer mail-buf start end))
  235.     (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)))
  236.  
  237. ;;; ========================================================================
  238. ;;; rmail class - mail reader interface - abstract
  239. ;;; ========================================================================
  240.  
  241. (defun rmail:init ()
  242.   "Initializes Hyperbole abstract mail interface for a particular mail reader.
  243. 'hmail:reader' should be set appropriately before this is called."
  244.   (hmail:init "rmail:" '("msg-hdrs-full" "msg-narrow" "msg-num"
  245.              "msg-prev" "msg-next"
  246.              "msg-to-p"  ;; 2 args: (mail-msg-id mail-file)
  247.              "msg-widen" "to"))
  248.   (hmail:init "lmail:" '("Summ-delete" "Summ-expunge" "Summ-goto" "Summ-to"
  249.              "Summ-undelete-all")))
  250.  
  251. (defvar rmail:msg-hdr-prefix "\\(^Date: \\|\n\nFrom [^ \n]+ \\)"
  252.   "String header preceding an e-mail received message-id.")
  253.  
  254. (defun rmail:msg-id-get ()
  255.   "Returns current msg id for an 'hmail:reader' buffer as a string, else nil.
  256. Signals error when current mail reader is not supported."
  257.   (let* ((reader (symbol-name hmail:reader))
  258.      ;; (toggled)
  259.      )
  260.     (or (fboundp 'rmail:msg-hdrs-full)
  261.     (error "(rmail:msg-id-get): Invalid mail reader: %s" reader))
  262.     (save-excursion
  263.       (unwind-protect
  264.       (progn
  265.         ;; (setq toggled (rmail:msg-hdrs-full nil))
  266.         (goto-char (point-min))
  267.         (if (re-search-forward (concat rmail:msg-hdr-prefix
  268.                        "\\(.+\\)"))
  269.         ;; Found matching msg
  270.         (buffer-substring (match-beginning 2) (match-end 2))))
  271.     ;; (rmail:msg-hdrs-full toggled)
  272.     ()
  273.     ))))
  274.  
  275. ;;; ------------------------------------------------------------------------
  276. ;;; Each mail reader-specific Hyperbole support module must also define
  277. ;;; the following functions, commonly aliased to existing mail reader
  278. ;;; functions within the "-init" function of the Hyperbole module.
  279. ;;; See "hrmail.el" for examples.
  280. ;;;
  281. ;;; rmail:get-new, rmail:msg-forward, rmail:summ-msg-to, rmail:summ-new
  282.  
  283. ;;; ************************************************************************
  284. ;;; Private variables
  285. ;;; ************************************************************************
  286.  
  287. (defvar hmail:hbdata-sep "\^Lbd"
  288.   "Text separating e-mail msg from any trailing Hyperbole button data.")
  289.  
  290. (provide 'hmail)
  291.